home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue65 / time / testUTC1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-10-18  |  16.7 KB  |  535 lines
  1. {: Demo Program for GpTimeZone by Primoz Gabrijelcic}
  2. {: modified by Ferenc Szentmiklosi almasw@elender.hu}
  3.  
  4. unit testUTC1;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  10.   StdCtrls, ComCtrls, Spin, Buttons,
  11.   gpTimezone;
  12.  
  13. type
  14.   TfrmMain = class(TForm)
  15.     lvTZ: TListView;
  16.     grpTimezone: TGroupBox;
  17.     Label2: TLabel;
  18.     outStandard: TMemo;
  19.     Label1: TLabel;
  20.     outDaylight: TMemo;
  21.     dateLocal: TDateTimePicker;
  22.     timeLocal: TDateTimePicker;
  23.     dateUTC: TDateTimePicker;
  24.     timeUTC: TDateTimePicker;
  25.     Label3: TLabel;
  26.     Label4: TLabel;
  27.     outInvalidTime: TEdit;
  28.     btnLocD2S: TButton;
  29.     btnLocS2D: TButton;
  30.     dateUTC2: TDateTimePicker;
  31.     timeUTC2: TDateTimePicker;
  32.     dateSwatch: TDateTimePicker;
  33.     lblSwatchHead: TLabel;
  34.     timeSwatch: TSpinEdit;
  35.     lblSwatch: TLabel;
  36.     dateSwatch2: TDateTimePicker;
  37.     lblSwatch2: TLabel;
  38.     timeSwatch2: TSpinEdit;
  39.     btnLocNow: TButton;
  40.     outUTCBias: TEdit;
  41.     Label5: TLabel;
  42.     Label6: TLabel;
  43.     StatusBar1: TStatusBar;
  44.     StMonth: TSpinEdit;
  45.     StDay: TSpinEdit;
  46.     StandardSet: TSpeedButton;
  47.     Label7: TLabel;
  48.     Label8: TLabel;
  49.     Label9: TLabel;
  50.     DlMonth: TSpinEdit;
  51.     Label10: TLabel;
  52.     DlDay: TSpinEdit;
  53.     DaylightSet: TSpeedButton;
  54.     StaticText1: TStaticText;
  55.     StaticText2: TStaticText;
  56.     procedure FormCreate(Sender: TObject);
  57.     procedure lvTZCompare(Sender: TObject; Item1, Item2: TListItem;
  58.       Data: Integer; var Compare: Integer);
  59.     procedure dateLocalChange(Sender: TObject);
  60.     procedure btnLocD2SClick(Sender: TObject);
  61.     procedure timeUTC2Change(Sender: TObject);
  62.     procedure lvTZClick(Sender: TObject);
  63.     procedure StandardSetClick(Sender: TObject);
  64.     procedure DaylightSetClick(Sender: TObject);
  65.     procedure FormDestroy(Sender: TObject);
  66.     procedure lvTZSelectItem(Sender: TObject; Item: TListItem;
  67.       Selected: Boolean);
  68.   private
  69.     UTC2    : TDateTime;
  70.     Swatch2 : TDateTime;
  71.     changing: boolean;
  72.     initDate: boolean;
  73.     RegTZ   : TGpRegistryTimeZones;
  74.     HomeTZ  : TTimeZoneInformation;
  75.     procedure ShowHint(Sender: TObject);
  76.     procedure LoadTimeZones;
  77.     procedure UpdateZoneTimes;
  78.   public
  79.   end;
  80.  
  81. var
  82.   frmMain: TfrmMain;
  83.   LocalTime   : TDateTime;
  84.   UtcTime     : TDateTime;
  85.   LocalID     : integer;
  86.   LocalSaving:boolean;
  87.  
  88. implementation
  89.  
  90. {$R *.DFM}
  91.  
  92. const
  93.   CSubName = 0;
  94.   CSubH    = 1;
  95.   CSubStdB = 2;
  96.   CSubDltB = 3;
  97.   CSubS    = 4;
  98.   CSubDT   = 5;
  99.  
  100. procedure TfrmMain.ShowHint(Sender: TObject);
  101. begin
  102.   StatusBar1.SimpleText := Application.Hint;
  103. end; { TfrmMain.ShowHint }
  104.  
  105. procedure TfrmMain.FormCreate(Sender: TObject);
  106. begin
  107.   Application.OnHint := ShowHint;
  108.   initDate := true;
  109.   RegTZ := TGpRegistryTimeZones.Create;
  110.   LoadTimeZones;
  111. end; { TfrmMain.FormCreate }
  112.  
  113. procedure TfrmMain.UpdateZoneTimes;
  114. var i:integer;
  115. begin
  116.   LocalTime:=now;
  117.   if LocalSaving then
  118.     UtcTime:=LocalTime+(strtoint(lvTZ.Items[LocalID].Subitems[CSubDltB])/MINUTESPERDAY)
  119.   else
  120.     UtcTime:=LocalTime+(strtoint(lvTZ.Items[LocalID].Subitems[CSubStdB])/MINUTESPERDAY);
  121.   for i := 0 to lvTZ.Items.Count - 1 do begin
  122.     if lvTZ.Items[i].Subitems[CSubS] = 'Y' then
  123.       lvTZ.Items[i].Subitems[CSubDT]:=formatdatetime('yyyy.mm.dd hh:nn',UtcTime+-1*(strtoint(lvTZ.Items[i].Subitems[CSubDltB])/MINUTESPERDAY))
  124.     else
  125.       lvTZ.Items[i].Subitems[CSubDT]:=formatdatetime('yyyy.mm.dd hh:nn',UtcTime+-1*(strtoint(lvTZ.Items[i].Subitems[CSubStdB])/MINUTESPERDAY));
  126.   end;
  127. end; { TfrmMain.UpdateZoneTimes }
  128.  
  129. procedure TfrmMain.LoadTimeZones;
  130. var
  131.   DayBias     : longint;
  132.   DaylightBias: longint;
  133.   disp        : string;
  134.   EndDate     : TDateTime;
  135.   eng         : string;
  136.   i           : integer;
  137.   North       : boolean;
  138.   p           : integer;
  139.   sign        : string;
  140.   StandardBias: longint;
  141.   StartDate   : TDateTime;
  142.   StdBias     : longint;
  143.   TZ          : TTimeZoneInformation;
  144. begin
  145.   lvTZ.Items.Clear;
  146.   LocalTime:=now;
  147.   UtcTime:=now;
  148.   RegTZ.Reload;
  149.   if GetTimeZoneInformation(HomeTZ) = DWORD($FFFFFFFF) then
  150.     FillChar(HomeTZ,SizeOf(HomeTZ),0);
  151.   for i := 0 to regTZ.Count-1 do begin
  152.     with lvTZ.Items.Add do begin
  153.       Data := pointer(RegTZ[i]);
  154.       TZ := RegTZ[i].TimeZone;
  155.       eng := RegTZ[i].EnglishName;
  156.       disp := RegTZ[i].DisplayName;
  157.       sign := '+';
  158.       if TZ.bias = 0 then
  159.         Caption := ''
  160.       else begin
  161.         if TZ.bias < 0 then
  162.           sign := '+'
  163.         else
  164.           sign := '-';
  165.         Caption := Format('%s%.2d:%.2d',[sign,Abs(TZ.bias) div 60,Abs(TZ.bias) mod 60]);
  166.       end;
  167.       if (disp <> '') and (disp[1] = '(') then begin
  168.         // strip (GMT+xx:xx) prefix
  169.         p := Pos(')',disp);
  170.         if p > 0 then
  171.           System.Delete(disp,1,p);
  172.         while (disp <> '') and (disp[1] = ' ') do
  173.           System.Delete(disp,1,1);
  174.       end;
  175.       Subitems.Add(eng);
  176.       if IsEqualTZ(TZ,HomeTZ) then
  177.         Subitems.Add('H') // home time zone
  178.       else
  179.         Subitems.Add('');
  180.       if GetTZDaylightSavingInfo (TZ, StartDate, EndDate, DaylightBias, StandardBias) then begin
  181.         StdBias := TZ.Bias + TZ.StandardBias;
  182.         DayBias := TZ.Bias + TZ.DaylightBias;
  183.         Subitems.Add(IntToStr(StdBias));
  184.         Subitems.Add(IntToStr(DayBias));
  185.         north := EndDate > StartDate;
  186.         if north then
  187.           if (LocalTime >= StartDate) and (LocalTime <= EndDate) then
  188.             Subitems.Add('Y')
  189.           else
  190.             Subitems.Add('N')
  191.         else if (LocalTime >= StartDate) and (LocalTime <= EndDate) then
  192.           Subitems.Add('N')
  193.         else
  194.           Subitems.Add('Y');
  195.       end
  196.       else begin
  197.         StdBias := TZ.Bias;
  198.         DayBias := TZ.Bias;
  199.         Subitems.Add(IntToStr(StdBias));
  200.         Subitems.Add(IntToStr(DayBias));
  201.         Subitems.Add('N');
  202.       end;
  203.       Subitems.Add('');
  204.     end; //with
  205.   end; //for
  206.   // select home time zone
  207.   lvTZ.Items[20].Selected := true;
  208.   for i := 0 to lvTZ.Items.Count - 1 do begin
  209.     if lvTZ.Items[i].Subitems[CSubH] <> '' then begin
  210.       lvTZ.Items[i].Selected := true;
  211.       lvTZ.Items[i].MakeVisible(false);
  212.       LocalSaving := lvTZ.Items[i].Subitems[CSubS] = 'Y';
  213.       LocalID:=i;
  214.       break;
  215.     end;
  216.   end; //for
  217.   UpdateZoneTimes;
  218.   lvTZ.OnCLick(lvTZ);
  219. end; { TfrmMain.LoadTimeZones }
  220.  
  221. procedure TfrmMain.lvTZCompare(Sender: TObject; Item1, Item2: TListItem;
  222.   Data: Integer; var Compare: Integer);
  223. var
  224.   bias1, bias2: longint;
  225. begin
  226.   bias1 := - TGpRegistryTimeZone(Item1.Data).TimeZone.Bias;
  227.   bias2 := - TGpRegistryTimeZone(Item2.Data).TimeZone.Bias;
  228.   if bias1 < bias2 then
  229.     Compare := -1
  230.   else if bias1 > bias2 then
  231.     Compare := 1
  232.   else
  233.     Compare := StrIComp(PChar(Item1.Caption),PChar(Item2.Caption));
  234. end; { TfrmMain.lvTZCompare }
  235.  
  236. procedure TfrmMain.dateLocalChange(Sender: TObject);
  237.  
  238.   function GetDT(dateUTC, timeuTC: TDateTimePicker): TDateTime;
  239.   begin
  240.     Result := Int(FixDT(dateUTC.Date))+Frac(FixDT(timeUTC.Time));
  241.   end; { GetDT }
  242.  
  243. var
  244.   tmp     : TDateTime;
  245.   date2   : TDateTime;
  246.   date    : TDateTime;
  247.   engName : string;
  248.   dispName: string;
  249.   TZ      : TTimeZoneInformation;
  250. begin
  251.   if not changing then begin
  252.     changing := true;
  253.     try
  254.       if assigned(lvTZ.Selected) then begin
  255.         with TGpRegistryTimeZone(lvTZ.Selected.Data) do begin
  256.           TZ       := TimeZone;
  257.           engName  := EnglishName;
  258.           dispName := DisplayName;
  259.         end; //with
  260.         // Recalc UTC from Internet Time.
  261.         if (Sender = dateSwatch) or (Sender = timeSwatch) then begin
  262.           date := SwatchToUTC(Trunc(dateSwatch.Date),timeSwatch.Value);
  263.           dateUTC.Date := date;
  264.           timeUTC.Time := date;
  265.         end;
  266.         // Recalc Local Time from UTC.
  267.         if (Sender = dateUTC) or (Sender = timeUTC) or
  268.            (Sender = dateSwatch) or (Sender = timeSwatch) then
  269.         begin
  270.           date := UTCToTZLocalTime(TZ,GetDT(dateUTC,timeUTC));
  271.           dateLocal.Date := date;
  272.           timeLocal.Time := date;
  273.           outInvalidTime.Hide; dateUTC.Show; timeUTC.Show;
  274.         end;
  275.         // Recalc UTC from Local Time. This will update second UTC display,
  276.         // show Invalid Time indicator etc.
  277.         date := TZLocalTimeToUTC(TZ,GetDT(dateLocal,timeLocal),false);
  278.         if date <> 0 then begin // valid time
  279.           outInvalidTime.Show;
  280.           date2 := TZLocalTimeToUTC(TZ,GetDT(dateLocal,timeLocal),true);
  281.           if not DateEQ(date,date2) then begin
  282.             if DateEQ(date2,GetDT(dateUTC,timeUTC)) then begin
  283.               tmp   := date;
  284.               date  := date2;
  285.               date2 := tmp;
  286.             end;
  287.             UTC2 := date2;
  288.             dateUTC2.Date := date2;
  289.             timeUTC2.Time := date2;
  290.             dateUTC2.Show; timeUTC2.Show;
  291.           end
  292.           else 
  293.             dateUTC2.Hide; timeUTC2.Hide;
  294.           dateUTC.Date := date;
  295.           timeUTC.Time := date;
  296.           dateUTC.Show; timeUTC.Show;
  297.         end
  298.         else begin
  299.           dateUTC.Hide; timeUTC.Hide; dateUTC2.Hide; timeUTC2.Hide;
  300.           outInvalidTime.Show;
  301.         end;
  302.         // Recalc Internet Time from all visible UTC Time controls.
  303.         if dateUTC.Visible then begin
  304.           timeSwatch.Value := UTCToSwatch(GetDT(dateUTC,timeUTC),date);
  305.           dateSwatch.Date := date;
  306.         end;
  307.         dateSwatch.Visible := dateUTC.Visible;
  308.         timeSwatch.Visible := dateUTC.Visible;
  309.         lblSwatch.Visible  := dateUTC.Visible;
  310.         lblSwatchHead.Visible := dateUTC.Visible;
  311.         if dateUTC2.Visible then begin
  312.           timeSwatch2.Value := UTCToSwatch(GetDT(dateUTC2,timeUTC2),Swatch2);
  313.           dateSwatch2.Date := Swatch2;
  314.         end;
  315.         dateSwatch2.Visible := dateUTC2.Visible;
  316.         timeSwatch2.Visible := dateUTC2.Visible;
  317.         lblSwatch2.Visible  := dateUTC2.Visible;;
  318.       end;
  319.     finally changing := false end;
  320.   end;
  321. end; { TfrmMain.dateLocalChange }
  322.  
  323. procedure TfrmMain.btnLocD2SClick(Sender: TObject);
  324. var
  325.   StdBias : longint;
  326.   DayBias : longint;
  327.   StdDate : TDateTime;
  328.   DayDate : TDateTime;
  329.   newDT   : TDateTime;
  330.   engName : string;
  331.   dispName: string;
  332.   TZ      : TTimeZoneInformation;
  333. begin
  334.   if assigned(lvTZ.Selected) then begin
  335.     with TGpRegistryTimeZone(lvTZ.Selected.Data) do begin
  336.       TZ       := TimeZone;
  337.       engName  := EnglishName;
  338.       dispName := DisplayName;
  339.     end; //with
  340.     if (Sender = btnLocNow) or
  341.        GetTZDaylightSavingInfo (TZ, DayDate, StdDate, DayBias, StdBias) then
  342.     begin
  343.       if Sender = btnLocD2S then
  344.         newDT := StdDate-(StdBias-DayBias)/MINUTESPERDAY
  345.       else if Sender = btnLocS2D then
  346.         newDT := DayDate
  347.       else if Sender = btnLocNow then
  348.         newDT := UTCToTZLocalTime(TZ,LocalTimeToUTC(Now,false))
  349.       else
  350.         newDT := 0;
  351.       dateLocal.Date := newDT;
  352.       timeLocal.Time := newDT;
  353.       dateLocalChange(dateLocal);
  354.     end;
  355.   end;
  356.   UpdateZoneTimes;  
  357. end; { TfrmMain.btnLocD2SClick }
  358.  
  359. procedure TfrmMain.timeUTC2Change(Sender: TObject);
  360. begin
  361.   dateUTC2.Date := UTC2;
  362.   timeUTC2.Time := UTC2;
  363.   dateSwatch2.Date := Swatch2;
  364. end; { TfrmMain.timeUTC2Change }
  365.  
  366. procedure TfrmMain.lvTZClick(Sender: TObject);
  367. var
  368.   DayBias     : longint;
  369.   StdBias     : longint;
  370.   StandardBias: longint;
  371.   DaylightBias: longint;
  372.   EndDate     : TDateTime;
  373.   StartDate   : TDateTime;
  374.   TZ          : TTimeZoneInformation;
  375.   engName     : string;
  376.   dispName    : string;
  377.   Item        : TListItem;
  378. const
  379.   OrdNums: array [1..5] of string = ('1st', '2nd', '3rd', '4th', 'last');
  380. begin
  381.   StMonth.Value:=1;
  382.   StDay.Value:=1;
  383.   DlMonth.Value:=1;
  384.   DlDay.Value:=1;
  385.   if lvTZ.Selected = nil then
  386.     Exit;
  387.   Item := lvTZ.Selected;
  388. // Most of this code was shamelessly stolen from Delphi Clinic,
  389. // The Delphi Magazine, Issue 49. It was written by Brian Long.
  390.   with TGpRegistryTimeZone(lvTZ.Selected.Data) do begin
  391.     TZ       := TimeZone;
  392.     engName  := EnglishName;
  393.     dispName := DisplayName;
  394.   end; //with
  395.   StaticText1.Caption := ' '+dispName+' ';
  396.   if GetTZDaylightSavingInfo (TZ, StartDate, EndDate, DaylightBias, StandardBias) then
  397.   begin
  398.     StdBias := TZ.Bias + TZ.StandardBias;
  399.     DayBias := TZ.Bias + TZ.DaylightBias;
  400.     outStandard.Lines.Clear;
  401.     outDaylight.Lines.Clear;
  402.     outStandard.Lines.Add(Format('%s, %d minute bias',[TZ.StandardName, StdBias]));
  403.     outDaylight.Lines.Add(Format('%s, %d minute bias',[TZ.DaylightName, DayBias]));
  404.     StMonth.Enabled:=true;
  405.     StDay.Enabled:=true;
  406.     DlMonth.Enabled:=true;
  407.     DlDay.Enabled:=true;
  408.     StandardSet.Enabled:=true;
  409.     DayLightSet.Enabled:=true;
  410.     if item.Subitems[CSubS] = 'Y' then begin // just saving
  411.       if TZ.DaylightName='' then
  412.         StaticText2.Caption:=item.Subitems[CSubName]
  413.       else
  414.         StaticText2.Caption:=TZ.DaylightName;
  415.     end
  416.     else begin
  417.       if TZ.StandardName='' then
  418.         StaticText2.Caption:=item.Subitems[CSubName]
  419.       else
  420.         StaticText2.Caption:=TZ.StandardName;
  421.     end;
  422.     if TZ.StandardDate.wYear = 0 then begin //"Day of month" date
  423.       with TZ.StandardDate do begin
  424.         outStandard.Lines.Add(Format('Starts on %s %s of %s at %s GMT', [
  425.           OrdNums[wDay], LongDayNames[wDayOfWeek + 1], LongMonthNames[wMonth],
  426.           TimeToStr(EncodeTime(wHour, wMinute, wSecond, wMilliseconds) + DayBias / MINUTESPERDAY)]));
  427.                              StMonth.Value:=wMonth;
  428.                                 StDay.Value:=wDay;
  429.       end;
  430.       outStandard.Lines.Add('This year: '+FormatDateTime('c',EndDate));
  431.     end
  432.     else begin //Absolute date
  433.       StMonth.Enabled:=false;
  434.       StDay.Enabled:=false;
  435.       DlMonth.Enabled:=false;
  436.       DlDay.Enabled:=false;
  437.       StandardSet.Enabled:=false;
  438.       DayLightSet.Enabled:=false;
  439.       outStandard.Lines.Add('Absolute date: '+
  440.         DateTimeToStr(SystemTimeToDateTime(TZ.StandardDate) + DayBias / MINUTESPERDAY));
  441.     end;
  442.     if TZ.DaylightDate.wYear = 0 then begin //"Day of month" date
  443.       with TZ.DaylightDate do begin
  444.         outDaylight.Lines.Add(Format('Starts on %s %s of %s at %s GMT', [
  445.           OrdNums[wDay], LongDayNames[wDayOfWeek + 1], LongMonthNames[wMonth],
  446.           TimeToStr(EncodeTime(wHour, wMinute, wSecond, wMilliseconds) + StdBias / MINUTESPERDAY)]));
  447.                                 DlMonth.Value:=wMonth;
  448.                                 DlDay.Value:=wDay;
  449.       end;
  450.       outDaylight.Lines.Add('This year: '+FormatDateTime('c',StartDate));
  451.     end
  452.     else begin //Absolute date
  453.       StMonth.Enabled:=false;
  454.       StDay.Enabled:=false;
  455.       DlMonth.Enabled:=false;
  456.       DlDay.Enabled:=false;
  457.       StandardSet.Enabled:=false;
  458.       DayLightSet.Enabled:=false;
  459.       outDaylight.Lines.Add('Absolute date: '+
  460.         DateTimeToStr(SystemTimeToDateTime(TZ.DaylightDate) + StdBias / MINUTESPERDAY));
  461.     end;
  462.     btnLocD2S.Enabled:=true;
  463.     btnLocS2D.Enabled:=true;
  464.   end
  465.   else begin // no DST
  466.     StMonth.Enabled:=false;
  467.     StDay.Enabled:=false;
  468.     DlMonth.Enabled:=false;
  469.     DlDay.Enabled:=false;
  470.     StandardSet.Enabled:=false;
  471.     DayLightSet.Enabled:=false;
  472.     outStandard.Text := Format('%s, %d minute bias',[TZ.StandardName, TZ.Bias]);
  473.     outDaylight.Text := 'not used';
  474.     StaticText2.Caption:=item.Subitems[CSubName];
  475.     btnLocD2S.Enabled:=false;
  476.     btnLocS2D.Enabled:=false;
  477.   end;
  478.   outUTCBias.Text := IntToStr(GetTZBias(TZ));
  479.   outStandard.Perform(EM_SETSEL,0,0);
  480.   outStandard.Perform(EM_SCROLLCARET,0,0);
  481.   outDaylight.Perform(EM_SETSEL,0,0);
  482.   outDaylight.Perform(EM_SCROLLCARET,0,0);
  483.   if initDate then begin
  484.     initDate := false;
  485.     dateLocal.Date := Trunc(Now);
  486.     timeLocal.Time := Frac(Now);
  487.   end;
  488.   dateLocalChange(dateLocal);
  489. end; { TfrmMain.lvTZClick }
  490.  
  491. procedure TfrmMain.StandardSetClick(Sender: TObject);
  492. var
  493.   TZ: TTimeZoneInformation;
  494. begin
  495.   with TGpRegistryTimeZone(lvTZ.Selected.Data) do begin
  496.     TZ := TimeZone;
  497.     TZ.StandardDate.wMonth := StMonth.Value;
  498.     TZ.StandardDate.wDay   := StDay.Value;
  499.     WriteAccess := true;
  500.     TimeZone := TZ;
  501.     WriteAccess := false;
  502.     lvTZClick(self);
  503.   end; //with
  504. end;
  505.  
  506. procedure TfrmMain.DaylightSetClick(Sender: TObject);
  507. var
  508.   TZ: TTimeZoneInformation;
  509. begin
  510.   with TGpRegistryTimeZone(lvTZ.Selected.Data) do begin
  511.     TZ := TimeZone;
  512.     TZ.DaylightDate.wMonth := DlMonth.Value;
  513.     TZ.DaylightDate.wDay   := DlDay.Value;
  514.     WriteAccess := true;
  515.     TimeZone := TZ;
  516.     WriteAccess := false;
  517.     lvTZClick(self);
  518.   end; //with
  519. end;
  520.  
  521. procedure TfrmMain.FormDestroy(Sender: TObject);
  522. begin
  523.   RegTZ.Free;
  524.   RegTZ := nil;
  525. end;
  526.  
  527. procedure TfrmMain.lvTZSelectItem(Sender: TObject; Item: TListItem;
  528.   Selected: Boolean);
  529. begin
  530.   if Selected then
  531.     lvTZClick(Sender);
  532. end; 
  533.  
  534. end.
  535.